home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / commad / comm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  10.6 KB  |  389 lines
  1. unit Comm;
  2.  
  3. interface
  4. uses Messages,WinTypes,WinProcs,Classes,Forms;
  5.  
  6. type
  7.   TPort=(tptNone,tptOne,tptTwo,tptThree,tptFour,tptFive,tptSix,tptSeven,
  8.          tptEight);
  9.   TBaudRate=(tbr110,tbr300,tbr600,tbr1200,tbr2400,tbr4800,tbr9600,tbr14400,
  10.              tbr19200,tbr38400,tbr56000,tbr128000,tbr256000);
  11.   TParity=(tpNone,tpOdd,tpEven,tpMark,tpSpace);
  12.   TDataBits=(tdbFour,tdbFive,tdbSix,tdbSeven,tdbEight);
  13.   TStopBits=(tsbOne,tsbOnePointFive,tsbTwo);
  14.   TCommEvent=(tceBreak,tceCts,tceCtss,tceDsr,tceErr,tcePErr,tceRing,tceRlsd,
  15.               tceRlsds,tceRxChar,tceRxFlag,tceTxEmpty);
  16.   TCommEvents=set of TCommEvent;
  17.  
  18. const
  19.   PortDefault=tptNone;
  20.   BaudRateDefault=tbr9600;
  21.   ParityDefault=tpNone;
  22.   DataBitsDefault=tdbEight;
  23.   StopBitsDefault=tsbOne;
  24.   ReadBufferSizeDefault=2048;
  25.   WriteBufferSizeDefault=2048;
  26.   RxFullDefault=1024;
  27.   TxLowDefault=1024;
  28.   EventsDefault=[];
  29.  
  30. type
  31.   TNotifyEventEvent=procedure(Sender:TObject;CommEvent:TCommEvents) of object;
  32.   TNotifyReceiveEvent=procedure(Sender:TObject;Count:Word) of object;
  33.   TNotifyTransmitEvent=procedure(Sender:TObject;Count:Word) of object;
  34.  
  35.   TComm=class(TComponent)
  36.   private
  37.     FPort:TPort;
  38.     FBaudRate:TBaudRate;
  39.     FParity:TParity;
  40.     FDataBits:TDataBits;
  41.     FStopBits:TStopBits;
  42.     FReadBufferSize:Word;
  43.     FWriteBufferSize:Word;
  44.     FRxFull:Word;
  45.     FTxLow:Word;
  46.     FEvents:TCommEvents;
  47.     FOnEvent:TNotifyEventEvent;
  48.     FOnReceive:TNotifyReceiveEvent;
  49.     FOnTransmit:TNotifyTransmitEvent;
  50.     FWindowHandle:hWnd;
  51.     hComm:Integer;
  52.     HasBeenLoaded:Boolean;
  53.     Error:Boolean;
  54.     procedure SetPort(Value:TPort);
  55.     procedure SetBaudRate(Value:TBaudRate);
  56.     procedure SetParity(Value:TParity);
  57.     procedure SetDataBits(Value:TDataBits);
  58.     procedure SetStopBits(Value:TStopBits);
  59.     procedure SetReadBufferSize(Value:Word);
  60.     procedure SetWriteBufferSize(Value:Word);
  61.     procedure SetRxFull(Value:Word);
  62.     procedure SetTxLow(Value:Word);
  63.     procedure SetEvents(Value:TCommEvents);
  64.     procedure WndProc(var Msg:TMessage);
  65.     procedure DoEvent;
  66.     procedure DoReceive;
  67.     procedure DoTransmit;
  68.   protected
  69.     procedure Loaded;override;
  70.   public
  71.     constructor Create(AOwner:TComponent);override;
  72.     destructor Destroy;override;
  73.     procedure Write(Data:PChar;Len:Word);
  74.     procedure Read(Data:PChar;Len:Word);
  75.     function IsError:Boolean;
  76.   published
  77.     property Port:TPort read FPort write SetPort default PortDefault;
  78.     property BaudRate:TBaudRate read FBaudRate write SetBaudRate
  79.       default BaudRateDefault;
  80.     property Parity:TParity read FParity write SetParity default ParityDefault;
  81.     property DataBits:TDataBits read FDataBits write SetDataBits
  82.       default DataBitsDefault;
  83.     property StopBits:TStopBits read FStopBits write SetStopBits
  84.       default StopBitsDefault;
  85.     property WriteBufferSize:Word read FWriteBufferSize
  86.       write SetWriteBufferSize default WriteBufferSizeDefault;
  87.     property ReadBufferSize:Word read FReadBufferSize
  88.       write SetReadBufferSize default ReadBufferSizeDefault;
  89.     property RxFullCount:Word read FRxFull write SetRxFull
  90.       default RxFullDefault;
  91.     property TxLowCount:Word read FTxLow write SetTxLow default TxLowDefault;
  92.     property Events:TCommEvents read FEvents write SetEvents
  93.       default EventsDefault;
  94.     property OnEvent:TNotifyEventEvent read FOnEvent write FOnEvent;
  95.     property OnReceive:TNotifyReceiveEvent read FOnReceive write FOnReceive;
  96.     property OnTransmit:TNotifyTransmitEvent read FOnTransmit write FOnTransmit;
  97.   end;
  98.  
  99. procedure Register;
  100.  
  101. implementation
  102.  
  103. procedure TComm.SetPort(Value:TPort);
  104. const
  105.   CommStr:PChar='COM1:';
  106. begin
  107.   FPort:=Value;
  108.   if (csDesigning in ComponentState) or
  109.      (not HasBeenLoaded) then exit;
  110.   if hComm>=0 then CloseComm(hComm);
  111.   if Value=tptNone then exit;
  112.   CommStr[3]:=chr(48+ord(Value));
  113.   hComm:=OpenComm(CommStr,ReadBufferSize,WriteBufferSize);
  114.   if hComm<0 then
  115.   begin
  116.     Error:=True;
  117.     exit;
  118.   end;
  119.   SetBaudRate(FBaudRate);
  120.   SetParity(FParity);
  121.   SetDataBits(FDataBits);
  122.   SetStopBits(FStopBits);
  123.   SetEvents(FEvents);
  124.   EnableCommNotification(hComm,FWindowHandle,FRxFull,FTxLow);
  125. end;
  126.  
  127. procedure TComm.SetBaudRate(Value:TBaudRate);
  128. var
  129.   DCB:TDCB;
  130. begin
  131.   FBaudRate:=Value;
  132.   if hComm>=0 then
  133.   begin
  134.     GetCommState(hComm,DCB);
  135.     case Value of
  136.       tbr110:DCB.BaudRate:=CBR_110;
  137.       tbr300:DCB.BaudRate:=CBR_300;
  138.       tbr600:DCB.BaudRate:=CBR_600;
  139.       tbr1200:DCB.BaudRate:=CBR_1200;
  140.       tbr2400:DCB.BaudRate:=CBR_2400;
  141.       tbr4800:DCB.BaudRate:=CBR_4800;
  142.       tbr9600:DCB.BaudRate:=CBR_9600;
  143.       tbr14400:DCB.BaudRate:=CBR_14400;
  144.       tbr19200:DCB.BaudRate:=CBR_19200;
  145.       tbr38400:DCB.BaudRate:=CBR_38400;
  146.       tbr56000:DCB.BaudRate:=CBR_56000;
  147.       tbr128000:DCB.BaudRate:=CBR_128000;
  148.       tbr256000:DCB.BaudRate:=CBR_256000;
  149.     end;
  150.     SetCommState(DCB);
  151.   end;
  152. end;
  153.  
  154. procedure TComm.SetParity(Value:TParity);
  155. var
  156.   DCB:TDCB;
  157. begin
  158.   FParity:=Value;
  159.   if hComm<0 then exit;
  160.   GetCommState(hComm,DCB);
  161.   case Value of
  162.     tpNone:DCB.Parity:=0;
  163.     tpOdd:DCB.Parity:=1;
  164.     tpEven:DCB.Parity:=2;
  165.     tpMark:DCB.Parity:=3;
  166.     tpSpace:DCB.Parity:=4;
  167.   end;
  168.   SetCommState(DCB);
  169. end;
  170.  
  171. procedure TComm.SetDataBits(Value:TDataBits);
  172. var
  173.   DCB:TDCB;
  174. begin
  175.   FDataBits:=Value;
  176.   if hComm<0 then exit;
  177.   GetCommState(hComm,DCB);
  178.   case Value of
  179.     tdbFour:DCB.ByteSize:=4;
  180.     tdbFive:DCB.ByteSize:=5;
  181.     tdbSix:DCB.ByteSize:=6;
  182.     tdbSeven:DCB.ByteSize:=7;
  183.     tdbEight:DCB.ByteSize:=8;
  184.   end;
  185.   SetCommState(DCB);
  186. end;
  187.  
  188. procedure TComm.SetStopBits(Value:TStopBits);
  189. var
  190.   DCB:TDCB;
  191. begin
  192.   FStopBits:=Value;
  193.   if hComm<0 then exit;
  194.   GetCommState(hComm,DCB);
  195.   case Value of
  196.     tsbOne:DCB.StopBits:=0;
  197.     tsbOnePointFive:DCB.StopBits:=1;
  198.     tsbTwo:DCB.StopBits:=2;
  199.   end;
  200.   SetCommState(DCB);
  201. end;
  202.  
  203. procedure TComm.SetReadBufferSize(Value:Word);
  204. begin
  205.   FReadBufferSize:=Value;
  206.   SetPort(FPort);
  207. end;
  208.  
  209. procedure TComm.SetWriteBufferSize(Value:Word);
  210. begin
  211.   FWriteBufferSize:=Value;
  212.   SetPort(FPort);
  213. end;
  214.  
  215. procedure TComm.SetRxFull(Value:Word);
  216. begin
  217.   FRxFull:=Value;
  218.   if hComm<0 then exit;
  219.   EnableCommNotification(hComm,FWindowHandle,FRxFull,FTxLow);
  220. end;
  221.  
  222. procedure TComm.SetTxLow(Value:Word);
  223. begin
  224.   FTxLow:=Value;
  225.   if hComm<0 then exit;
  226.   EnableCommNotification(hComm,FWindowHandle,FRxFull,FTxLow);
  227. end;
  228.  
  229. procedure TComm.SetEvents(Value:TCommEvents);
  230. var
  231.   EventMask:Word;
  232. begin
  233.   FEvents:=Value;
  234.   if hComm<0 then exit;
  235.   EventMask:=0;
  236.   if tceBreak in FEvents then inc(EventMask,EV_BREAK);
  237.   if tceCts in FEvents then inc(EventMask,EV_CTS);
  238.   if tceCtss in FEvents then inc(EventMask,EV_CTSS);
  239.   if tceDsr in FEvents then inc(EventMask,EV_DSR);
  240.   if tceErr in FEvents then inc(EventMask,EV_ERR);
  241.   if tcePErr in FEvents then inc(EventMask,EV_PERR);
  242.   if tceRing in FEvents then inc(EventMask,EV_RING);
  243.   if tceRlsd in FEvents then inc(EventMask,EV_RLSD);
  244.   if tceRlsds in FEvents then inc(EventMask,EV_RLSDS);
  245.   if tceRxChar in FEvents then inc(EventMask,EV_RXCHAR);
  246.   if tceRxFlag in FEvents then inc(EventMask,EV_RXFLAG);
  247.   if tceTxEmpty in FEvents then inc(EventMask,EV_TXEMPTY);
  248.   SetCommEventMask(hComm,EventMask);
  249. end;
  250.  
  251. procedure TComm.WndProc(var Msg:TMessage);
  252. begin
  253.   with Msg do
  254.   begin
  255.     if Msg=WM_COMMNOTIFY then
  256.     begin
  257.       case lParamLo of
  258.         CN_EVENT:DoEvent;
  259.         CN_RECEIVE:DoReceive;
  260.         CN_TRANSMIT:DoTransmit;
  261.       end;
  262.     end
  263.     else
  264.       Result:=DefWindowProc(FWindowHandle,Msg,wParam,lParam);
  265.   end;
  266. end;
  267.  
  268. procedure TComm.DoEvent;
  269. var
  270.   CommEvent:TCommEvents;
  271.   EventMask:Word;
  272. begin
  273.   if (hComm<0) or not Assigned(FOnEvent) then exit;
  274.   EventMask:=GetCommEventMask(hComm,Integer($FFFF));
  275.   CommEvent:=[];
  276.   if (tceBreak in Events) and (EventMask and EV_BREAK<>0) then
  277.     CommEvent:=CommEvent+[tceBreak];
  278.   if (tceCts in Events) and (EventMask and EV_CTS<>0) then
  279.     CommEvent:=CommEvent+[tceCts];
  280.   if (tceCtss in Events) and (EventMask and EV_CTSS<>0) then
  281.     CommEvent:=CommEvent+[tceCtss];
  282.   if (tceDsr in Events) and (EventMask and EV_DSR<>0) then
  283.     CommEvent:=CommEvent+[tceDsr];
  284.   if (tceErr in Events) and (EventMask and EV_ERR<>0) then
  285.     CommEvent:=CommEvent+[tceErr];
  286.   if (tcePErr in Events) and (EventMask and EV_PERR<>0) then
  287.     CommEvent:=CommEvent+[tcePErr];
  288.   if (tceRing in Events) and (EventMask and EV_RING<>0) then
  289.     CommEvent:=CommEvent+[tceRing];
  290.   if (tceRlsd in Events) and (EventMask and EV_RLSD<>0) then
  291.     CommEvent:=CommEvent+[tceRlsd];
  292.   if (tceRlsds in Events) and (EventMask and EV_Rlsds<>0) then
  293.     CommEvent:=CommEvent+[tceRlsds];
  294.   if (tceRxChar in Events) and (EventMask and EV_RXCHAR<>0) then
  295.     CommEvent:=CommEvent+[tceRxChar];
  296.   if (tceRxFlag in Events) and (EventMask and EV_RXFLAG<>0) then
  297.     CommEvent:=CommEvent+[tceRxFlag];
  298.   if (tceTxEmpty in Events) and (EventMask and EV_TXEMPTY<>0) then
  299.     CommEvent:=CommEvent+[tceTxEmpty];
  300.   FOnEvent(Self,CommEvent);
  301. end;
  302.  
  303. procedure TComm.DoReceive;
  304. var
  305.   Stat:TComStat;
  306. begin
  307.   if (hComm<0) or not Assigned(FOnReceive) then exit;
  308.   GetCommError(hComm,Stat);
  309.   FOnReceive(Self,Stat.cbInQue);
  310.   GetCommError(hComm,Stat);
  311. end;
  312.  
  313. procedure TComm.DoTransmit;
  314. var
  315.   Stat:TComStat;
  316. begin
  317.   if (hComm<0) or not Assigned(FOnTransmit) then exit;
  318.   GetCommError(hComm,Stat);
  319.   FOnTransmit(Self,Stat.cbOutQue);
  320. end;
  321.  
  322. procedure TComm.Loaded;
  323. begin
  324.   inherited Loaded;
  325.   HasBeenLoaded:=True;
  326.   SetPort(FPort);
  327. end;
  328.  
  329.  
  330. constructor TComm.Create(AOwner:TComponent);
  331. begin
  332.   inherited Create(AOwner);
  333.   FWindowHandle:=AllocateHWnd(WndProc);
  334.   HasBeenLoaded:=False;
  335.   Error:=False;
  336.   FPort:=PortDefault;
  337.   FBaudRate:=BaudRateDefault;
  338.   FParity:=ParityDefault;
  339.   FDataBits:=DataBitsDefault;
  340.   FStopBits:=StopBitsDefault;
  341.   FWriteBufferSize:=WriteBufferSizeDefault;
  342.   FReadBufferSize:=ReadBufferSizeDefault;
  343.   FRxFull:=RxFullDefault;
  344.   FTxLow:=TxLowDefault;
  345.   FEvents:=EventsDefault;
  346.   hComm:=-1;
  347. end;
  348.  
  349. destructor TComm.Destroy;
  350. begin
  351.   DeallocatehWnd(FWindowHandle);
  352.   if hComm>=0 then CloseComm(hComm);
  353.   inherited Destroy;
  354. end;
  355.  
  356. procedure TComm.Write(Data:PChar;Len:Word);
  357. begin
  358.   if hComm<0 then exit;
  359.   if WriteComm(hComm,Data,Len)<0 then Error:=True;
  360.   GetCommEventMask(hComm,Integer($FFFF));
  361. end;
  362.  
  363. procedure TComm.Read(Data:PChar;Len:Word);
  364. begin
  365.   if hComm<0 then exit;
  366.   if ReadComm(hComm,Data,Len)<0 then Error:=True;
  367.   GetCommEventMask(hComm,Integer($FFFF));
  368. end;
  369.  
  370. function TComm.IsError:Boolean;
  371. begin
  372.   IsError:=Error;
  373.   Error:=False;
  374. end;
  375.  
  376. procedure Register;
  377. begin
  378.   RegisterComponents('Additional',[TComm]);
  379. end;
  380.  
  381. end.
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.